Aminet 22/Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso/Aminet/dev/amos/amos_col.lha/AMOS-COL/INTRO.amos/INTRO.amosSourceCode

AMOS Source Code | 1980-01-10 | 5KB | 215 lines

'By Delta/Opium
'
'�ukasz �elezny
'ul. W�oska 4D/6
'42-612 Tarnowskie G�ry
'Poland
' *******************
' *     JAMTRO      *
' *                 *
' * This is Delta's *
' * contribution    *
' * for JAM. Hey    *
' * JAM! Do u like  *
' * this little     *
' * product...      *
' *                 *
' * JAM - i �ycie   *
' * ma sens!        *
' *                 *
' * wykreowaned &   *
' * skodowaned by   *
' *                 *
' * DELTA/OPIUM^HV  *
' *                 *
' * Brokol! Tylko   *
' * �eby� nic tu    *
' * misiaczku nie   *
' * zmienia�.       *
' * I gazety mi     *
' * wiesiu oddaj.   *
' *                 *
' *    THE  END     *
' *      FINE       *
' *     KANIEC      *
' *     KONIEC      *
' *                 *
' *  !!! DELTA !!!  *
' *******************
BLOKUJ
MAIN
Procedure MAIN
   Trap Screen Close 0
   Led Off
   Track Play 6 : Track Loop On
   Unpack 11 To 1
   Screen Hide 1
   Erase 11
   Screen Open 2,640,310,16,Hires+Laced
   Screen Hide 2 : Curs Off : Flash Off : Get Palette 1 : Palette $0,$999,$FFF,$AAA : Screen Copy 1 To 2 : Shift Up 1,4,15,1 : Screen Display 2,,145,,
   WELCOME
   Screen Display 2,,310,, : Screen Show 2 : Screen To Front 2 : Screen 2
   For G=310 To 145 Step -1
      Screen Display 2,,G,,
      Wait Vbl
   Next
   PISZ[" -     F O R   C O O L     -",10,40,0]
   PISZ[" -      C O N T A C T      - ",10,70,0]
   PISZ[" -     W R I T E   T O     - ",10,100,0]
   PISZ[" ---------------------------",10,10,0]
   PISZ[" ---------------------------",10,130,0]
   Wait 50
   For Y=1 To 150
      Screen Copy 1,0,Y,640,Y+1 To 2,0,Y
      Wait Vbl
   Next
   PISZ[" -       J   A   M         -",10,40,0]
   PISZ[" -  UL  FRANCUSKA 1A%4     -",10,70,0]
   PISZ[" -  42-6OO TARNOWSKIE GORY -",10,100,0]
   PISZ[" -        POLAND %OFKOZ%   -",10,130,0]
   PISZ[" ---------------------------",10,10,0]
   PISZ[" ---------------------------",10,160,0]
   Repeat : Until Mouse Key
   For Y=1 To 340/2
      Screen Copy 1,0,Y,640,Y+1 To 2,0,Y
      Screen Copy 1,0,340-Y,640,340-Y+1 To 2,0,340-Y
      Wait Vbl
   Next
   PISZ["  -    C  R  E  D  I  T  S   -",10,50,0]
   PISZ["  - CODE     BY   *-//    DELTA -",10,100,0]
   PISZ["  - M*US/I/C*//    ///BY   //-    TIMER -",10,150,0]
   PISZ["  - GRAPHI//CS BY   -    DELTA *-",10,200,0]
   PISZ["  ----------------------------",10,10,0]
   PISZ["  ----------------------------",10,270,0]
   PISZ["  - LM*B - EXIT              / - ",10,240,0]
   Repeat
   Until Mouse Key=1
   For X=1 To 640/2
      Screen Copy 1,X,0,X+1,340 To 2,X,0
      Screen Copy 1,640-X,0,640-X+1,340 To 2,640-X,0
   Next
   Screen Close 1
   For G=145 To 310
      Screen Display 2,,G,,
      Wait Vbl
   Next
   Screen Close 2
   For Y=-40 To 100
      Screen Display 0,,Y,,
      Wait Vbl
   Next Y
   Fade 4,0,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
   Wait 65
   Fade 4
   Wait 65
   Screen Close 0
   End
End Proc
Procedure PISZ[T$,X,Y,CZAS]
   For NR=1 To Len(T$)
      ZNAK$=Mid$(T$,NR,1)
      If ZNAK$<>" "
         If ZNAK$="*"
            X=X+5
            Goto SKOK
         End If
         If ZNAK$="+"
            X=X+2
            Goto SKOK
         End If
         If ZNAK$="/"
            X=X-1
            Goto SKOK
         End If
         NU=Asc(ZNAK$)-64
         If ZNAK$="-"
            NU=27
         End If
         If ZNAK$="%"
            NU=29
         End If
         If ZNAK$="1"
            NU=30
         End If
         If ZNAK$="2"
            NU=31
         End If
         If ZNAK$="3"
            NU=32
         End If
         If ZNAK$="4"
            NU=33
         End If
         If ZNAK$="5"
            NU=34
         End If
         If ZNAK$="6"
            NU=35
         End If
         If ZNAK$="7"
            NU=36
         End If
         If ZNAK$="8"
            NU=37
         End If
         If ZNAK$="9"
            NU=38
         End If
         If ZNAK$="�"
            NU=39
         End If
         Inc O
         If O>2
            O=1
         End If
         If O=1
            For K=640 To X Step -4
               Bob 1,K,Y,NU
               For HH=1 To 20
               Next
            Next K
         End If
         If O=2
            For K=0 To X Step 4
               Bob 1,K,Y,NU
               For HH=1 To 20
               Next
            Next K
         End If
         Bob Off : Wait Vbl
         Paste Bob X,Y,NU
      End If
      X=X+20
      If CZAS>0
         Wait CZAS
      End If
      SKOK:
   Next
End Proc
Procedure WELCOME
   Unpack 10 To 0
   Screen Hide 0
   Erase 10
   Screen Display 0,,100,,
   Dim K(31)
   For KOL=0 To 16
      K(KOL)=Colour(KOL)
   Next KOL
   Palette 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
   Screen Show 0
   Fade 4,0,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF,$FFF
   Wait 45
   For Y=100 To -40 Step -1
      Screen Display 0,,Y,,
      Wait Vbl
   Next Y
   Fade 4,K(0),K(1),K(2),K(3),K(4),K(5),K(6),K(7),K(8),K(9),K(10),K(11),K(12),K(13),K(14),K(15)
   Wait 45
End Proc
Procedure BLOKUJ
   Amos Lock
   Break Off
   Request Off
   Close Workbench
   Hide
End Proc